Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / iktmac.asm < prev next >

Wrap

Assembly Source File | 1992-09-29 | 45.1 KB | 571 lines

*COPY RTEXT 00800000 MACRO 00801000 &LABEL RTEXT &BUF,&PROMPT=,&E= 00802000 .* Read from the terminal, possible prompt. Get length read in R0. 00803000 .* &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any 00804000 .* (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error 00805000 GBLC &KVRSN,&KSYS @SC89027 00805100 AIF ('&KVRSN' EQ '4.2' OR '&KSYS' EQ '').VOK @SC90072 00805200 MNOTE 16,'* * * --> IKTMAC version number should be &KVRSN' @SC89027 00805300 .VOK ANOP @SC89027 00805400 &LABEL DS 0H @SC86299 00806000 AIF (T'&PROMPT EQ 'O').NOPR @SC87268 00807000 AIF ('&PROMPT(1)'(1,1) NE '(').NOSV1 @SC89214 00807100 ST &PROMPT(1),RTXTSV Save register, in case (1) @SC89214 00807200 .NOSV1 ANOP @SC89214 00807300 KCALL SUPFNC,7,E=RTE&SYSNDX Skip prompt if stacked @SC88095 00807400 AIF ('&PROMPT(1)'(1,1) NE '(').NOSV2 @SC89214 00807500 L &PROMPT(1),RTXTSV @SC89214 00807600 .NOSV2 ANOP @SC89214 00807700 TPUT &PROMPT(1),&PROMPT(2),ASIS @SC87268 00808000 .NOPR ANOP 00809000 RTE&SYSNDX KCALL GETLIN,&BUF,E=&E @SC88095 00809100 MEND 00810000 *COPY DMSFREE 00811000 MACRO 00812000 &LABEL DMSFREE &DWORDS=(0),&ERR= 00813000 .* Obtain free storage block: len=8*(R0). Returns ptr in R1, but 00814000 .* preserves registers 2-14 00815000 .* &DWORDS= length in doublewords should be in R0, 00816000 .* &ERR= branch if failure 00817000 &LABEL LREG 0,&DWORDS @SC86299 00818000 SLA 0,3 @SC86299 00819000 AIF ('&ERR' NE '').COND @SC86345 00820000 GETMAIN R,LV=(0) @SC86299 00821000 MEXIT 00822000 .COND GETMAIN RC,LV=(0) @SC86345 00823000 LTR 15,15 @SC86345 00824000 BNZ &ERR @SC86345 00825000 MEND 00826000 *COPY DMSFRET 00827000 MACRO 00828000 &LABEL DMSFRET &DWORDS=(0),&LOC=(1),&ERR= 00829000 .* Return free storage block: len=8*(R0), adr=(R1). Preserve R2-14. 00830000 .* &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1), 00831000 .* &ERR= branch if failure 00832000 &LABEL LREG 0,&DWORDS @SC86299 00833000 SLA 0,3 @SC86299 00834000 FREEMAIN R,LV=(0),A=&LOC @SC86299 00835000 MEND 00836000 *COPY WRITF 00837000 MACRO 00838000 &LABEL WRITF &TICK,&BUFFER=,&BSIZE=,&E= 00839000 .* Write to a disk file (ticket ptr in R1) 00840000 .* &1: adr of file access ticket returned by OPENF (A), 00841000 .* &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00842000 .* given, it replaces FDB value (see OPENF), &E= branch on error 00843000 &LABEL READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10 00844000 MEND 00845000 *COPY READF 00846000 MACRO 00847000 &LABEL READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9 00848000 .* Read from disk file (or write) (see WRITF, but also...) 00848500 .* &2: NONUM means chop off numbers 00849000 LCLC &R @SC86299 00850000 LCLA &C @SC88101 00850100 &C SETA &CODE @SC88101 00850200 AIF (T'&NONUM EQ 'O').RDC @SC88101 00850300 AIF ('&NONUM' NE 'NONUM').ER1 @SC88101 00850400 &C SETA 0 Code 0 means exclude sequence nos.@SC88101 00850500 .RDC ANOP @SC88101 00850600 &LABEL L 1,&TICK @SC86299 00851000 AIF ('&BUFFER' EQ '').BZ @SC86299 00852000 AIF ('&BUFFER'(1,1) NE '(').BLA @SC86299 00853000 &R SETC '&BUFFER(1)' @SC86299 00854000 AGO .BST @SC86299 00855000 .BLA LA 15,&BUFFER @SC86299 00856000 &R SETC '15' @SC86299 00857000 .BST ST &R,FDBBUFF-FABD(1) @SC86299 00858000 .BZ AIF ('&BSIZE' EQ '').SZ @SC86299 00859000 AIF ('&BSIZE'(1,1) NE '(').SLA @SC86299 00860000 &R SETC '&BSIZE(1)' @SC86299 00861000 AGO .SST @SC86299 00862000 .SLA LA 15,&BSIZE @SC86299 00863000 &R SETC '15' @SC86299 00864000 .SST ST &R,FDBBSIZ-FABD(1) @SC86299 00865000 .SZ LA 0,&C @SC88101 00866000 KCALL DISKIO,E=&E @SC86299 00867000 MEXIT 00867300 .ER1 MNOTE 2,'INVALID PARAMETER ''&NONUM''' @SC88101 00867600 MEND 00868000 *COPY SAVEF 00868100 MACRO 00868200 &LABEL SAVEF &TICK,&E= @SC88168 00868300 .* Update disk directory for given file (ticket ptr in R1) 00868400 .* &1: adr of file access ticket (A), &E= branch on error 00868500 &LABEL L 1,&TICK @SC88168 00868600 READF &TICK,E=&E,CODE=21 @SC88168 00868700 MEND 00868800 *COPY KSETKW 00869000 MACRO 00870000 KSETKW , @SC87166 00871000 .* Define system-specific SET/SHOW parameters (keywords) 00872000 KW 'DELIM',SHODLM,MIN=4 @SC88095 00872500 KW 'PREFIX',SHODST,MIN=3 @SC87166 00873000 MEND 00875000 *COPY KSETPRC 00876000 MACRO 00877000 KSETPRC 00878000 .* System-specific SET handlers (in any order). No operands. 00879000 PUSH PRINT @SC86355 00880000 PRINT GEN @SC86355 00881000 SETDST KCALL CWDSET @SC86164 00882000 B RTRN Preserve return code @SC86295 00883000 SETDLM NTOKN N=SETDLM1,H=SETDLMH @SC88095 00883100 LTR 7,7 Exactly one character? @SC88095 00883200 BNZ SETDLMH No, explain it @SC88095 00883300 MVC LNDLM,0(6) Yes, use that character @SC88095 00883400 B RTRN0 @SC88095 00883500 SETDLM1 MVI LNDLM,C' ' Turn delimiter off @SC88095 00883600 B RTRN0 @SC88095 00883700 SETDLMH PTEXT 'Line delimiter: one char or none' @SC88095 00883800 B SUBERR @SC88095 00883900 POP PRINT @SC86355 00884000 MEND 00885000 *COPY KSHOPRC 00886000 MACRO 00887000 KSHOPRC 00888000 .* System-specific SHOW handlers (in same order as KW). No operands. 00889000 PUSH PRINT @SC86355 00890000 PRINT GEN @SC86355 00891000 SHODLM LA 8,LNDLM Show delimiter @SC88095 00891200 BAL 14,SHOCHR @SC88095 00891400 B SETDLM @SC88095 00891600 SHODST LA 8,DEST @SC86316 00892000 LH 9,DESTL Get length @SC86316 00893000 BAL 14,SHOCHRN @SC86295 00894000 B SETDST @SC87166 00895000 POP PRINT @SC86355 00898000 MEND 00899000 *COPY KFILKW 00900000 MACRO 00901000 KFILKW , @SC87166 00902000 .* Define system-specific file attribute parameters (keywords) 00903000 KW 'BLKSIZE',SHOBSZ,MIN=2 @SC87166 00904000 KW 'RECFM',SHORFM @SC87166 00905000 KW 'SPACE',SHOTRK,MIN=2 @SC87166 00906000 KW 'UNIT',SHOUNT @SC87166 00907000 KW 'VOLUME',SHOVOL,MIN=2 @SC87166 00908000 MEND 00909000 *COPY KFILSET 00910000 MACRO 00911000 KFILSET 00912000 .* Specific SET FILE handlers (any order). No operands. 00913000 PUSH PRINT @SC87012 00914000 PRINT GEN @SC87012 00915000 SETRECVF MVC FILRCF,0(6) Copy RECFM @SC88120 00916000 B RTRN0 @SC87012 00917000 * @SC87012 00918000 SETRFM BAL 4,SETSCN @SC87012 00919000 KW 'FIXED',SETRECVF @SC87012 00920000 KW 'VARIABLE',SETRECVF @SC87012 00921000 KW 'UNDEFINED',SETRECVF @SC86295 00922000 KW , @SC87012 00923000 * 00924000 SETUNT BAL 2,SETFSTR Get fixed-format string @SC86316 00925000 TR FILUNT,UPCASE Should always be upper case @SC88020 00925500 MVC LOGUNT,FILUNT @SC86316 00926000 B RTRN0 @SC86316 00927000 * 00928000 SETVOL BAL 2,SETFSTR Get fixed-format string @SC86295 00929000 TR FILVOL,UPCASE Should always be upper case @SC88020 00929500 MVC LOGVOL,FILVOL @SC86316 00930000 B RTRN0 @SC86295 00931000 POP PRINT @SC87012 00932000 MEND 00933000 *COPY KFILSHO 00934000 MACRO 00935000 KFILSHO 00936000 .* Specific SHOW FILE handlers (same order as KW). No operands. 00937000 PUSH PRINT @SC87012 00938000 PRINT GEN @SC87012 00939000 SHOBSZ L 8,MAXBSZ Limit @SC87166 00940000 LH 4,FILBLKSI @SC87320 00941000 BAL 14,SHONUM Print it @SC86295 00942000 B RTRN0 @SC86295 00943000 SHORFM LA 8,FILRCF @SC88120 00944000 BAL 14,SHOCHR @SC87012 00945000 B SETRFM @SC87166 00946000 SHOTRK L 8,MAXBSZ Limit @SC87166 00947000 L 4,FILTRKAL @SC88026 00948000 BAL 14,SHONUM Print it @SC86295 00949000 B RTRN0 @SC87166 00950000 SHOUNT LA 8,FILUNT @SC86316 00951000 LA 9,8 @SC86316 00952000 BAL 14,SHOCHRN @SC86316 00953000 B SETUNT @SC87166 00954000 SHOVOL LA 8,FILVOL @SC86295 00955000 LA 9,6 @SC86295 00956000 BAL 14,SHOCHRN @SC86295 00957000 B SETVOL @SC87166 00958000 POP PRINT @SC87012 00959000 MEND 00960000 *COPY WTEXT 00961000 MACRO 00962000 &LABEL WTEXT &ARG,&LEN 00963000 .* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4) 00964000 .* Preserves R2-R14 00965000 .* &1: 'text' (where text has no doubled ' or & characters) OR 00966000 .* &1: adr of text (LA/R), &2: length of text (LA/R) 00967000 &LABEL PTEXT &ARG,&LEN,AREG=1,LREG=0 @SC86295 00968000 BAL 15,WTEXT 'TPUT' @SC87020 00969000 MEND 00970000 *COPY FDBD 00971000 MACRO 00972000 FDBD 00973000 .* Map of File Descriptor Block + File Access Block 00974000 FABD DSECT , @SC86295 00975000 FABRELAD DS 17X FAB maps DCB @SC86299 00976000 FABREL DS AL3 @SC86299 00977000 FABBUFNO DS 0BL1 @SC86299 00978000 FABBUFCB DS A @SC86299 00979000 FABBUFL DS H @SC86299 00980000 FABDSORG DS BL2 @SC86299 00981000 FABIOBAD DS A @SC86299 00982000 FABEODAD DS A @SC86299 00983000 FABRECFM DS 0BL1 @SC86299 00984000 FABRECU EQU X'C0' Undefined-length records @SC86299 00985000 FABRECF EQU X'80' Fixed-length records @SC86299 00986000 FABRECV EQU X'40' Varying-length records @SC86299 00987000 FABRECBR EQU X'10' Blocked records @SC86299 00988000 FABRECCC EQU X'06' Control chars present @SC88106 00988500 FABEXLST DS A @SC86299 00989000 FABDDNAM DS CL8 @SC86299 00990000 FABOFLGS DS BL1 @SC86299 00991000 FABIFLG DS BL1 @SC86299 00992000 FABMACR DS BL2 @SC86299 00993000 ORG FABDDNAM @SC86299 00994000 FABTIOT DS BL2 @SC86299 00995000 FABMACRF DS BL2 @SC86299 00996000 FABDEBAD DS A @SC86299 00997000 FABGET DS A @SC86299 00998000 FABCHECK DS A @SC86299 00999000 FABSYNAD DS A @SC86299 01000000 FABCIND1 DS BL2 @SC86299 01001000 FABBLKSI DS H @SC86299 01002000 FABWCPO DS BL4 @SC86299 01003000 FABIOBA DS A @SC86299 01004000 FABEOBAD DS A @SC86299 01005000 FABRECAD DS A @SC86299 01006000 FABDIRCT DS H @SC86299 01007000 FABLRECL DS H @SC86299 01008000 FABCNTRL DS A @SC86299 01009000 ORG FABD+90 @SC86299 01010000 FABPRECL DS AL2 @SC86299 01011000 FABEOB DS A @SC86299 01012000 FDBD DS 0F Beginning of short descriptor @SC86295 01013000 FDBBUFF DS A Buffer ptr @SC86295 01014000 FDBBSIZ DS F Max record length @SC86295 01015000 FDBRCF DS C Record format @SC86295 01016000 FDBFLGS DS X Flags @SC86295 01017000 FDBACTV EQU X'80' File is already open @SC86295 01018000 * SVATT EQU X'40' Preserve attributes @SC90033 01018500 * APPN EQU X'10' DISP=MOD @SC86295 01019000 *ABRECCC EQU X'06' Control chars present @SC88246 01020000 PDSF EQU X'01' Dataset is a PDS @SC87015 01021000 FDBLRC DS H File record length @SC86295 01022000 FDBTRKAL DS F File track allocation increment @SC88026 01023000 FDBBLKSI DS H File block size @SC86295 01024000 FDBDEVT DS XL4 Device type (must precede VOL) @SC88106 01024500 FDBVOL DS CL6 File volume label @SC86295 01025000 FDBUNT DS CL8 File unit name @SC86299 01026000 FDBSIZE DS F File size in Kbytes @SC86299 01028000 FDBCOP EQU *-FDBD Length to copy for OPEN @SC90037 01028500 FDBDATE DS XL7,X Time stamp: packed yyyymmddhhmmss @SC88235 01029000 FABDSN DS CL52 Dataset name @SC86299 01032000 FABDSMB EQU FABDSN+44,8 Member name @SC88119 01032050 FDBINFO EQU *-FDBD Length of info returned @SC86295 01032100 FABLRTR DS F Record length for truncation @SC88120 01032300 FABEXL DS 3A Modifiable EXLST @SC89073 01032600 FABCOMM DS CL8 Command name @SC87351 01033000 FABDWDS EQU (*-FABD+7)/8 @SC86295 01034000 MEND 01035000 *COPY FDBPAT 01036000 MACRO 01037000 FDBPAT &N,&RFM,&SIZ @SC88120 01038000 .* Define system-dependent part of output FDB patterns 01039000 .* &1: variable-name prefix (or null if defining init. values) 01040000 .* &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01040500 LCLC &T,&B,&D,&V,&U,&Z @SC88287 01041000 LCLC &R,&F,&L,&S,&P4 @SC90037 01041500 AIF ('&N' EQ '').ALC @SC86316 01042000 &R SETC 'RCF' @SC88120 01042200 &F SETC 'FLGS' @SC88120 01042400 &L SETC 'LRC' @SC88120 01042600 &T SETC 'TRKAL' @SC87320 01043000 &B SETC 'BLKSI' @SC87320 01044000 &D SETC 'DEVT' @SC88287 01044500 &V SETC 'VOL' @SC86316 01045000 &U SETC 'UNT' @SC86316 01046000 &S SETC 'FSIZ' @SC90037 01046500 .ALC ANOP @SC86316 01047000 &N&R DC C'&RFM' RECFM @SC88120 01047100 &N&F DC X'00' Flags @SC88120 01047200 AIF ('&SIZ' EQ '').DONE @SC88120 01047300 AIF ('&RFM' NE 'V').OKL @SC88120 01047400 &P4 SETC '+4' Add 4 for RDW @SC88120 01047500 .OKL ANOP @SC88120 01047600 &N&L DC Y(&SIZ&P4) LRECL @SC88120 01047700 &N&T DC F'5' Track allocation @SC88026 01048000 &Z SETC '6233' Default block size @SC87320 01049000 AIF ('&SIZ' NE 'LPKT').P1 @SC88120 01050000 &Z SETC 'LPKT+8' Block size for log file @SC87320 01051000 .P1 ANOP 01052000 &N&B DC Y(&Z) @SC87320 01053000 &N&D DC XL4'0' Device type (must precede VOL) @SC88287 01053500 &N&V DC CL6' ' No volume specified @SC87320 01054000 &N&U DC CL8' ' Default unit @SC88054 01055000 &N&S DC F'0' File size in Kbytes @SC90037 01055200 .DONE ANOP @SC88120 01055500 MEND 01056000 *COPY KSYSVAR 01057000 MACRO 01058000 KSYSVAR 01059000 .* Define system-dependent globally-known variables 01060000 COMPTR DS 2A Common/storage ptrs @SC87015 01061000 APGPB GETLINE MF=L Parameter block for GETLINE @NW86330 01062000 STAXPLR STAX 0,MF=L Parameter block for STAX (replace)@NW86330 01064000 IOPLAREA DS 4F IOPL @TS86001 01065000 ORGPCMD DS CL8 Saved ECT PCMD field @SC89052 01065500 CPECB DS F GETLINE/PUTLINE/PUTGET ECB @TS86001 01066000 ECBREAD DS F @NW86330 01067000 TASKADD DS A Async task adr @NW86330 01068000 SYSPROC DS A Ptr to CLIST library DCB @SC89073 01068500 ECBTGET DS F @NW86330 01069000 KTGETT DS 2F Adr and length of read request @SC87015 01070000 PUTLINAD DS A Adr of PUTLINE routine @SC88026 01070500 GETLINAD DS A Adr of GETLINE routine @NW86330 01071000 DFMSGP DS A Ptr to DAIR message buffer @SC88119 01073000 CATDSPTR DS A Catalog buffer ptr @NW86330 01075000 NXSFPTR DS A Ptr to suffix comparand @SC87015 01076000 CIRPARM DS 0F @NW86330 01077000 CIROPT DS X'02' Get all matches @NW86330 01078000 DS 2AL1(0) Reserved by system @NW86330 01079000 CIRLOCRC DS AL1(0) Locate return code @NW86330 01080000 CIRSRCH DS A Search arg: adr of test DSN @NW86330 01081000 CIRCVOL DS F'0' Vol adr=0 - force cat lookup @NW86330 01082000 CIRWA DS A Ptr to user work area @NW86330 01083000 CIRSAVE DS A Ptr to save area for macro @NW86330 01084000 CIRPSWD DS F'0' Adr of password @NW86330 01085000 DESTL DS H'0' Length @SC86299 01085500 DEST DS CL44 Default PREFIX @SC86299 01086000 DESTP DS C' ' PDS indicator ('.' if so) @SC86299 01087000 RTXTSV DS F Saved register for prompt @SC89214 01087050 CAMLOC DS 4F Ptrs for locating dataset @SC86299 01087100 CAMOBT DS 4F Ptrs for getting DSCB @SC86299 01087200 DSKCOD EQU CAMOBT Temp for function code @SC88101 01087300 CAMVOLS DS 0D,XL265 Storage for volume list @SC86299 01087400 CAMDEVT EQU CAMVOLS+2,4 1st device type @SC88106 01087500 ORG CAMVOLS+100 Do a little overlaying @SC88049 01087600 CAMDSCB DS 0F,XL101 Storage for DSCB @SC88014 01087700 ORG CAMDSCB+1 @SC88014 01087800 DS1VOL DS CL6,XL2 Volume serial @SC86299 01087900 DS1CRDT DS 2XL3,3X,XL8 Creation date @GH89270 01088000 DS1MDDT DS XL3 Modification date (ASM2) @GH89270 01088010 DS1MDTM DS XL2 Modification time of day (ASM2) @GH89270 01088020 DS1RFDT DS XL3,XL4 Reference date @SC86299 01088100 DS1DSO DS XL2 Dataset org @SC86299 01088200 DS1RCF DS X Record format @SC86299 01088300 DS1OPT DS X Error option @SC86299 01088400 DS1BLK DS H Block size @SC86299 01088500 DS1LRC DS H Logical record length @SC86299 01088600 LKPMEM DS CL8 Temporary for member name if mig. @SC89250 01088650 ORG , @SC86299 01088700 DS 0F @SC86299 01089000 DSKSTT EQU *-FDBD+FABD @SC86299 01090000 DS XL(FDBINFO) Room for FDB @SC86299 01091000 NXFN DS CL(LFID) Pattern filespec for search @SC87015 01092000 DSNPFL DS H Prefix length for search @NW86330 01093000 DSNSFL DS H Suffix length for search @NW86330 01094000 ICPRGS DS 4F Saved registers for type-out @SC88026 01095000 ICPFL DS X Flag for type-out interception @SC87020 01096000 SCRLST DS X Flag for previous I/O op @SC88091 01096500 STMUCH DS XL2 Saved user profile values @SC86299 01097000 OLDUPTSW DS X Old UPTSWS field, saved for STCOM @TL89181 01097100 PTLLEN DS 0F,2H PUTLINE data descriptor @SC88026 01097200 PTLBUF DS CL133 @SC88026 01097400 STKDSN DS CL(LFID) DSN for STACK @SC88026 01097600 * 01097680 DSKFL DS X Flags for catalog scanning @SC90033 01097760 NXDON EQU X'40' Catalog search done @SC87015 01097840 WFN EQU X'08' Filename contains wild chars @SC88246 01097920 MEND 01098000 *COPY KSYSTF 01099000 MACRO 01100000 KSYSTF 01101000 .* Define system-dependent globally-known constants and init. variables 01102000 .* symb .DS + label &P.DEFS mark start of variables/init. values 01103000 GBLC &STORDS @SC89268 01103500 LCLC &P 01104000 PUSH PRINT 01105000 PRINT GEN 01106000 AIF ('&SYSECT' EQ '&STORDS').DS @SC89268 01107000 &P SETC 'I' For initial values 01108000 WTEXT STM 14,1,ICPRGS Save @SC88026 01109000 CLI ICPFL,2 Intercepting? @SC88026 01109200 BE WTXICP Yes, do it @SC88026 01109400 MVC PTLBUF,0(1) Copy to buffer @SC88026 01109600 A 0,F4 @SC88026 01109800 STH 0,PTLLEN And save length @SC88026 01110000 MVI CPECB,0 Clear ECB @SC88119 01110100 L 15,PUTLINAD @SC88026 01110200 PUTLINE PARM=PTPB,MF=(E,IOPLAREA),ENTRY=(15) @SC88026 01110400 B WTXRET @SC87020 01113000 WTXICP KCALL ICPTYP Call interception routine @SC87020 01114000 WTXRET LM 14,1,ICPRGS Restore @SC88026 01115000 BR 15 @SC87020 01116000 KSYSATOE DC A(0) Normal TTY E/A translation @SC88302 01116300 KSYSETOA DC A(0) @SC88302 01116600 SYSATR DC AL1(ADOT,ABL+2,AI,A2) ."I2 System type=TSO @SC88273 01117000 LSYSATR EQU *-SYSATR Length of stuff for A-packet @SC88273 01117500 LOGNAM DC C'KER.LOG' @SC86299 01118000 REPNAM DC C'KER.REPLY' @SC86299 01119000 SYSTAKE DC C'''SYS1' @SC88113 01120000 DKERMINI DC C'.KERMINI''' @SC88113 01120500 LSYST EQU *-SYSTAKE @SC86299 01121000 USRTAKE DC C'KERMINI' Init file @SC86299 01122000 LUSRT EQU *-USRTAKE @SC86299 01123000 KMAIL1 DC C'KERMAIL ' System cmd for invoking mail @SC90037 01123100 KMAIL2 DC C' LIST(' @SC90037 01123200 KMAIL3 DC C')' @SC90037 01123300 KPRNT1 DC C'KERMPRT ' System cmd for printing @SC90037 01123400 KPRNT2 DC C' OPTIONS(' @SC90037 01123500 KPRNT3 DC C')' @SC90037 01123600 KSUBM1 DC C'KERMSUB ' System cmd for submitting job @SC90037 01123700 KSUBM2 DC C' OPTIONS(' @SC90037 01123800 KSUBM3 DC C')' @SC90037 01123900 CIRWAL DC H'32004,0' Length of catalog work area @SC87015 01125000 KSYSNIT CSECT @SC89215 01125500 .DS ANOP 01126000 &P.DEFS DS 0D 01127000 * Timer exit routine @SC88299 01127090 USING *,15 Addressiblity for getting ECB @SC88299 01127180 &P.TMXIT STM 0,1,20(13) Save registers @SC88299 01127270 ICM 1,15,&P.TMXPT Get ptr to target ECB @SC88299 01127360 POST (1),1 @SC88299 01127450 LM 0,1,20(13) Restore registers @SC88299 01127540 BR 14 Return to system @SC88299 01127630 &P.TMXPT DS AL4 Ptr to ECB @SC88299 01127720 DROP 15 @SC88299 01127810 * 01127900 &P.KPRPL DC AL1(L'KPRPT) @SC89268 01128000 &P.KPRPT DC C'Kermit-TSO>' @SC87268 01129000 ORG &P.KPRPT+20 @SC87268 01130000 &P.LNDLM DC C' ' Initially no delimiter @SC88095 01130200 POP PRINT 01131000 &P.PTPB PUTLINE MF=L,OUTPUT=(0,TERM,SINGLE,DATA) @SC88026 01131100 MEND 01132000 *COPY KSYSBUF 01133000 MACRO 01134000 KSYSBUF 01135000 .* Store buffer ptrs from R1 and increment R1 for specific buffers 01136000 LA 0,4-1 @SC87015 01137000 AR 1,0 @SC87015 01138000 OR 1,0 @SC87015 01139000 XR 1,0 @SC87015 01140000 ST 1,CIRSAVE Catalog scan save area @SC87015 01141000 LA 1,72(1) @SC87015 01142000 ST 1,CIRWA Catalog info buffer @SC87015 01143000 AH 1,CIRWAL @SC87015 01144000 ST 1,CIRSRCH Catalog search comparand @SC87015 01145000 LA 1,44(1) @SC87015 01146000 ST 1,DFMSGP DAIR message buffer @SC88119 01146300 LA 1,512(1) @SC88119 01146600 MEND 01147000 *COPY SSYMS 01148000 MACRO 01149000 SSYMS 01150000 .* Set global symbols for conditional assembly 01151000 GBLC &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT @SC88309 01152000 GBLC &KEDIT,&STORDS,&KTAG @SC90067 01152500 GBLA &MAXLR,&MAXBS @SC86268 01153000 &KSYS SETC 'TSO' System name @SC86299 01154000 MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***' 01155500 &MAXLR SETA 32756 Max lrecl @SC86299 01156000 &MAXBS SETA 32760 Max blksize @SC86299 01157000 &S1CMD SETC 'F1C2' S/1 command prefix @LP88187 01158000 &KCONT SETC 'T' Default controller type (TTY) @SC88309 01158500 PUSH PRINT 01159000 PRINT GEN 01160000 MAXWT EQU 1024 Max TPUT buffer @SC86299 01161000 MAXRT EQU 1024 Max TGET buffer @SC86299 01162000 LFID EQU 60 Max length of filespec @SC88342 01163000 &TYPCMD SETC 'LIST' Host command for TYPE @SC86299 01164000 TYPMIN EQU 4 Min abbrv of system TYPE cmd or 2 @SC86299 01165000 FBRK1 EQU C'<' Starting character for options @SC89218 01165300 FBRK2 EQU C'>' Ending character for options @SC89218 01165600 KMAXE EQU 1920-7 < 9025 Kermit extended max pkt @SC87351 01166000 STKDWDS EQU 511 Size of save-area stack @SC87012 01167000 &STORDS SETC 'KSTORG' Storage DSECT for Kermit globals @SC89268 01167200 KWRKBASE EQU 11 Base register for work area @SC89268 01167400 KSUBBASE EQU 12 Base register for CSECT @SC89268 01167600 POP PRINT 01168000 MEND @SC86268 01169000 *COPY SYSMACS 01170000 MACRO 01171000 SYSMACS 01172000 .* Include system control block definition macros and list all macros 01173000 MNOTE '---MACROs: ATTACH, CATALOG, CLOSE, DETACH, DEVTYPE,' 01174000 MNOTE '--- ESTAI, FIND, FREEMAIN,' 01174500 MNOTE '--- FREEPOOL, GETLINE, GETMAIN, GTSIZE, IDENTIFY,' 01175000 MNOTE '--- IKJCPPL, IKJECT, IKJGTPB, IKJIOPL, IKJUPT,' 01175050 MNOTE '--- LINK, LOAD, LOCATE, OBTAIN, OPEN, POST,' 01175100 MNOTE '--- PUTLINE, RDJFCB, SAVE, SCRATCH, STATUS, STAX,' 01175150 MNOTE '--- STCOM, STFSMODE, STIMER, STSIZE, SYNADAF,' 01175200 MNOTE '--- SYNADRLS, TGET, TPG, TPUT, TTIMER, WAIT' 01175250 IKJCPPL , @SC86299 01179000 IKJECT , @SC86299 01182000 IKJGTPB , @NW86330 01183000 IKJIOPL , @TS86001 01184000 IKJUPT , @SC86299 01186000 * DSECT for addressing catalog information work area 01187000 CATDSET DSECT @NW86330 01188000 TYPEBYTE DS XL1 Type byte we want only A's @NW86330 01189000 CATDNAME DS 44CL1 Data set name @NW86330 01190000 MEND @SC86268 01191000 *COPY STRTMSGS 01192000 MACRO 01193000 &LABEL STRTMSGS 01194000 .* Print system-dependent start-up messages 01195000 &LABEL CLI S1HND,XON @SC87338 01196000 BNE STRT1Z @SC87338 01197000 CLI TRMTP,C'T' @SC87338 01198000 BE STRT1Z @SC87338 01199000 CLI TRMTP,C'V' @SC89020 01199300 BE STRT1Z @SC89020 01199600 WTEXT 'Handshake is XON -- not needed' @SC87338 01200000 STRT1Z DS 0H @SC87338 01201000 MEND @SC87338 01202000 *COPY KMAIN 01203000 MACRO 01204000 &LABEL KMAIN &TYPE 01205000 .* Linkage conventions with system. 01206000 .* &1: ENTER if entering, RETURN if returning 01207000 AIF ('&TYPE' NE 'RETURN').ENT @SC89268 01208000 &LABEL L 13,4(13) Unlink @SC86295 01209000 ST 15,16(13) Save return code @SC86295 01210000 LA 0,STODWDS+STKDWDS @SC87012 01211000 LR 1,KWRKBASE @SC89268 01212000 DMSFRET DWORDS=(0),LOC=(1) @SC86295 01213000 LM 14,12,12(13) Restore registers @SC86295 01214000 BR 14 @SC86295 01215000 MEXIT , @SC89268 01216000 .ENT AIF ('&TYPE' NE 'ENTER').OTH @SC89268 01217000 LR KSUBBASE,15 @SC89268 01218000 L 10,=A(COMMON) Common code addressibility @SC86316 01219000 LA 0,STODWDS+STKDWDS @SC87012 01220000 DMSFREE DWORDS=(0) Get storage for vars + stack @SC86295 01221000 LR KWRKBASE,1 Get addressibility @SC89268 01222000 LR 0,1 @SC86295 01223000 LA 1,8*STODWDS Length of storage @SC86295 01224000 SR 15,15 Zero fill @SC86295 01225000 MVCL 0,14 @SC86295 01226000 LR 15,0 Start of stack @SC86295 01227000 A 0,=A(8*STKDWDS) End of stack @SC87012 01228000 STM 15,0,STKPTR @SC86295 01229000 ST 15,STKLO @SC89089 01230000 LM 15,1,16(13) Restore registers @SC86295 01231000 MEXIT , @SC89268 01232000 .OTH MNOTE 12,'Invalid type &TYPE' @SC89268 01233000 MEND @SC89268 01234000